home *** CD-ROM | disk | FTP | other *** search
/ Netware Super Library / Netware Super Library.iso / menu_pgm / send_fe1 / send_fe1.bas < prev    next >
Encoding:
BASIC Source File  |  1990-08-22  |  21.3 KB  |  675 lines
  1. 'This program works in conjunction with :
  2. 'Novell SEND v1.11 and USERLIST v2.10 for use in Saber (and other)
  3. 'menu shells.
  4. '
  5. 'It should work with any version of SEND v1.11 or greater, but (since it
  6. 'depends upon the text output formatting of USERLIST) may have to be edited
  7. 'for different versions. Better yet, get the DOS or C calls and poll
  8. 'NetWare directly.
  9. '
  10. ' (C)opyright 08/08/90 by Bob Welker. Written in QB v4.5
  11. ' with code from Crescent Software QuickPak Professional library v3.14
  12. '
  13. '   Disclaimer : Caveat emptor! No guarantees! You are on your own!
  14. '   Released into the user community ... if you use code from this
  15. '   please give mention to the few hours I spent writing it.
  16. '
  17. '   Variables collected for other USERLIST stats, although not used
  18. '   in this version.
  19. '
  20. DEFINT A-Z
  21.  
  22. DECLARE SUB Calc (ULRow, ULCol, FG, BG)
  23. DECLARE SUB BarPrint (Choice$(), Stat%())
  24. DECLARE SUB HideCursor ()
  25. DECLARE SUB InitMouse (MouseThere%)
  26. DECLARE SUB MQPrint (x$, colr%)
  27. DECLARE SUB PullDnMs (Menu$(), Stat(), Menu%, Choice%, Ky$, Action%)
  28. DECLARE SUB SetCursor (Row, Col)
  29. DECLARE SUB ShowCursor ()
  30. DECLARE SUB TextCursor (FG%, BG%)
  31. DECLARE SUB PickList (items$(), picked%(), NPicked%, Cnf AS ANY)
  32. DECLARE SUB ReadFile (BYVAL Address)
  33. DECLARE SUB TextIn (T$, Max, NumOnly, CapsOn, ExitCode, colr)
  34. DECLARE SUB SysTime (T$)
  35. DECLARE SUB MQPrint (Work$, colr%)
  36. DECLARE SUB MPaintBox (ULRow%, ULCol%, LRRow%, LRCol%, colr%)
  37. DECLARE SUB MsgBox (message$, With%, Cnf AS ANY)
  38. DECLARE SUB ReplaceChar2 (Work$, Old$, New$)
  39. DECLARE SUB Calendar (Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
  40. DECLARE SUB GetQuery (Query$, ScanCode, ExitCode)
  41. DECLARE SUB WaitKey ()
  42.  
  43. DECLARE FUNCTION PullMenKey% (Ky$, Menu$(), Stat())
  44. DECLARE FUNCTION Monitor% ()            'Used in SetCnf.Bi
  45. DECLARE FUNCTION OneColor% (FG, BG)
  46. DECLARE FUNCTION Peek1% (Segment, Address)
  47. DECLARE FUNCTION Exist% (FileName$)
  48. DECLARE FUNCTION MinInt% (Var1%, Var2%)
  49. DECLARE FUNCTION Delimit% (Work$, Delimiter$)
  50.  
  51. ' you'll have to change where the include files are looked for.
  52. '
  53. '$INCLUDE: 'c:\pro\DefCnf.BI'
  54. '$INCLUDE: 'c:\pro\SetCnf.BI'
  55. 'a$INCLUDE: 'T:DefCnf.BI'
  56. 'a$INCLUDE: 'T:SetCnf.BI'
  57.  
  58. CONST FALSE = 0
  59. CONST true = NOT FALSE
  60. DIM UserName$(100): DIM ConnectionNum$(100): DIM LoginDate$(100): DIM LoginTime$(100)
  61.  
  62. '$DYNAMIC
  63. DIM items$(100)                 ' set up dynamic array for user names
  64.  
  65. ON ERROR GOTO DOShandler        ' trap DOS errors
  66. ErrorMsg$ = ""                  ' no error message
  67.  
  68. TopLine$ = "┌─────────────────────────────────────────────────────┐"
  69. MidLine$ = "│                                                     │ "
  70. BottomLine$ = "└─────────────────────────────────────────────────────┘"
  71.  
  72. BottomMsg$ = " F1=Help   F3=Calc  F5=Calendar   F10=Exit "
  73.  
  74. '   note : This program is not particularly color aware insofar as it
  75. '          is being written on a monochrome system.
  76.  
  77. GOSUB SetColor                       ' determine if the monitor is mono or color
  78. GOSUB ResetScreen                    ' initial screen setup
  79. GOSUB GetEnv                         ' get Saber Menu environment strings
  80.  
  81. TOP:                                 ' begin
  82.  
  83. SLEEP 1
  84.  
  85. InitMouse Temp                         'Define the Mouse cursor
  86. TextCursor -2, 4                       'Inverse foreground red background
  87. SetCursor 1, 1                         'Locate it at upper right of screen
  88. ShowCursor                             'Turn it on
  89.  
  90. GetServer1:
  91. SRING1$ = " What server to send message to (default = "
  92. SRING2$ = ") ? "
  93. LOCATE 5, 2: CALL MQPrint(SRING1$ + Server$ + SRING2$, 3)
  94. GetServer2:
  95.      Max = 15: NumOnly = 0: CapsOn = 1
  96.      LOCATE 8, 5
  97.      CALL TextIn(Server$, Max, NumOnly, CapsOn, XCode, TextColr)
  98.  
  99.      IF XCode = 0 OR XCode = 1 THEN
  100.         LOCATE 10, 5
  101.         PRINT " Do you wish to (E)dit or (A)ccept the server name? "
  102.         CALL GetQuery(Query$, ScanCode, XCode)
  103.         IF ScanCode > 58 THEN GOSUB SelectScanCode
  104.         SELECT CASE Query$
  105.             CASE "A"
  106.                 GOSUB ResetScreen
  107.             CASE "E"
  108.                 GOSUB ResetScreen
  109.                 GOTO GetServer1
  110.             CASE ELSE
  111.                 GOTO GetServer2
  112.         END SELECT
  113.  
  114.      ELSEIF XCode = 2 THEN
  115.     GOTO ExitNice
  116.      ELSEIF XCode > 58 THEN        ' function key pressed
  117.  
  118.         ScanCode = XCode
  119.         GOSUB SelectScanCode
  120.         IF ScanCode >= 59 AND ScanCode <= 69 THEN GOTO GetServer1
  121.  
  122.      END IF
  123.  
  124. IF LEN(Server$) < 1 THEN    ' no server name given
  125.     GOSUB ClearArea
  126.     BEEP
  127.     LOCATE 14, 5: CALL MQPrint(" Please enter a server name ... ", 4)
  128.     SLEEP 4
  129.     GOSUB ResetScreen
  130.     GOTO GetServer1
  131. END IF
  132.  
  133.      GOSUB ResetScreen
  134.  
  135. GetMessage1:
  136.     T$ = SPACE$(11)     ' create empty string for date information
  137.     CALL SysTime(T$)    ' get system time
  138.     LOCATE 4, 65: CALL MQPrint(" " + LEFT$(T$, 5) + " ", 3)' display truncated time stamp
  139.     LOCATE 2, 65: CALL MQPrint(" " + DATE$ + " ", 3)    ' display date stamp
  140.     LOCATE 5, 2: CALL MQPrint(" Enter the message you wish to send ", 3)
  141.     LOCATE 7, 5: CALL MQPrint(" ESC to abort; ENTER to submit message ", 3)
  142.  
  143. GetMessage2:
  144.     MaxMessLen = 45    ' maximum allowable length of Novell SEND message
  145.     NumOnly = 0 ' accept mixed alphanumeric symbols
  146.     CapsOn = 0  ' do not capitalize all message characters
  147.     LOCATE 10, 5
  148.  
  149.     MaxMessLen = MaxMessLen - LEN(CurrentUser$)   'truncate message for user's name
  150.     CALL TextIn(SendMessage$, MaxMessLen, NumOnly, CapsOn, XCode, TextColr)
  151.  
  152.      IF XCode = 0 OR XCode = 1 THEN
  153.          LOCATE 12, 5: PRINT " Do you wish to (E)dit or (S)end the message? "
  154.  
  155.          CALL GetQuery(Query$, ScanCode, XCode)
  156.          IF ScanCode > 58 THEN GOSUB SelectScanCode
  157.          SELECT CASE Query$
  158.              CASE "S"
  159.                  GOSUB ResetScreen
  160.              CASE "E"
  161.                  GOSUB ResetScreen
  162.                  GOTO GetMessage1
  163.              CASE ELSE
  164.                  GOTO GetMessage1
  165.          END SELECT
  166.  
  167.   ELSEIF XCode = 2 THEN         ' back up to last option
  168.      GOSUB ResetScreen
  169.      GOTO GetServer1
  170.   ELSEIF XCode > 58 THEN        ' function key pressed
  171.  
  172.      ScanCode = XCode
  173.      GOSUB SelectScanCode
  174.      IF ScanCode >= 59 AND ScanCode <= 69 THEN GOTO GetMessage1
  175.  
  176.   END IF
  177.  
  178.   GOSUB ResetScreen
  179.  
  180. IF LEN(SendMessage$) < 1 THEN
  181.     GOSUB ClearArea
  182.     BEEP
  183.     LOCATE 14, 5: CALL MQPrint(" Must have at least one character in your message ... ", 4)
  184.     SLEEP 4
  185.     GOSUB ResetScreen
  186.     GOTO GetMessage1
  187. END IF
  188.  
  189. ReplaceChar2 SendMessage$, CHR$(32), CHR$(255)  ' replace spaces in message
  190.  
  191. CLS
  192. MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
  193. LOCATE 2, 5: CALL MQPrint("Getting user list ... please wait", 3)
  194. PRINT
  195. SLEEP 1
  196.  
  197. ' get current directory, and save for cleanup routine
  198.  
  199. drive$ = CHR$(GetDrive%) ' returned as decimal equiv of UCASE drive letter
  200.                          ' then changed to drive letter
  201.  
  202. StartDir$ = GetDir$(GetDrive%)    ' get current default directory string
  203.  
  204. StartPath$ = drive$ + ":" + StartDir$' full default directory spec
  205.  
  206. IF TempFilePath$ = "" THEN        ' make temp files in current dir
  207.     TempFilePath$ = StartPath$    ' if S_FILEDIR not set in env
  208. ELSE
  209.     CALL CDir(TempFilePath$)
  210. END IF
  211.  
  212. n = 1   ' if a temp file already exists then increment the last character
  213.         ' of the extension by one. Note : this will crap out on large
  214.         ' (>99 user) network if everyone were to send a message at the
  215.         ' same time.
  216. DO
  217.     n$ = STR$(n)
  218.     TempFileName$ = TempFilePath$ + "usertemp." + LTRIM$(RTRIM$(n$))
  219.     IsHere = Exist%(TempFileName$)  ' create unique temp file
  220.  
  221.     IF IsHere% = true THEN
  222.         n = n + 1
  223.     ELSE
  224.         EXIT DO
  225.     END IF
  226. LOOP
  227.  
  228. SHELL "userlist >" + TempFileName$      ' get user names from USERLIST
  229.                                         ' C API or DOS calls would be nicer here
  230. count = 1
  231.  
  232. ' pull data from USERLIST apart, and place into variables
  233.  
  234.         OPEN TempFileName$ FOR INPUT AS #1         ' get user names
  235.  
  236.         LINE INPUT #1, InString$            ' throw away 1st line
  237.         LINE INPUT #1, ServerName$          ' get server name
  238.                 ServerName$ = MID$(ServerName$, 29, 15)
  239.         LINE INPUT #1, InString$            ' throw away 3rd line
  240.         LINE INPUT #1, InString$            ' throw away 4th line
  241.  
  242.         DO
  243.                 LINE INPUT #1, InString$                        ' get body of data
  244.              
  245.                 ConnectionNum$(count) = MID$(InString$, 4, 2)   ' connection number
  246.                 UserName$(count) = MID$(InString$, 13, 15)      ' user name
  247.  
  248.                 LoginInStatus$ = MID$(InString$, 11, 1)         ' get status
  249.                         'IF LogInStatus$ = "*" THEN
  250.                         '        UserName$(count) = CurrentUser$
  251.                         'END IF
  252.                         ' not used in this version - getting info from environment
  253.  
  254.                 LoginDate$(count) = MID$(InString$, 29, 8)       ' user login date
  255.                 LoginTime$(count) = MID$(InString$, 40, 8)       ' user login time
  256.  
  257.                 count = count + 1
  258.         LOOP UNTIL EOF(1)
  259.  
  260. CLOSE #1
  261.  
  262. 'clean up temporary files, and reset original directory
  263.  
  264. CALL KILLFILE(TempFileName$)
  265.  
  266. IF TempFilePath$ <> StartPath$ THEN
  267.     CALL CDir(StartPath$)
  268. END IF
  269.  
  270. GetUserNames:
  271. REDIM items$(count + 1)               'Dim the "Items$" array
  272.  
  273. FOR n = 1 TO count              'Pad elements to 15 for names
  274.     items$(n) = SPACE$(18)            ' plus three for check marks
  275. NEXT
  276.  
  277. FOR n = 1 TO (count)            ' feed userlist info into ITEM
  278.     items$(n) = UserName$(n)
  279. NEXT
  280. items$(count) = "EVERYONE"          ' for global messages
  281.  
  282. MaxNum = MinInt%(20, count)             'Allow up to 20 users to be picked
  283. REDIM picked(MaxNum)                    'Dim the array
  284.  
  285. '----- Print instructions
  286. CLS
  287. LOCATE 2, 30: CALL MQPrint(" Select users who will receive message with ", 3)
  288. LOCATE 3, 30: CALL MQPrint(" ENTER or SPACEBAR keys, and/or mouse. ", 3)
  289. SRING1$ = " Choose up to "
  290. SRING2$ = " users. "
  291. LOCATE 5, 30: CALL MQPrint(SRING1$ + STR$(MaxNum) + SRING2$, 3)
  292. LOCATE 7, 30: CALL MQPrint("Press [ESC] when done.", 3)
  293. LOCATE 3, 2, 0                           'Turn the cursor off
  294. PRINT
  295.  
  296. CALL TextCursor(-2, -2)                 'set mouse colors to inverse
  297. CALL ShowCursor                         'Turn it on
  298.  
  299.  
  300. '----- pick network user names
  301. PickList items$(), picked(), NPicked, Cnf
  302. CALL HideCursor                         'Turn the Mouse cursor off
  303.  
  304.  
  305. '----- Show what they picked
  306. IF NPicked <= 0 THEN
  307.      BEEP
  308.      LOCATE 20, 5: PRINT SPC(75);
  309.      LOCATE 20, 5: CALL MQPrint(" No users selected ... exiting ", 4)
  310.      SLEEP 4
  311.      SYSTEM
  312. END IF
  313.  
  314. GOSUB ResetScreen
  315.  
  316. IF NPicked THEN
  317.     FOR n = 1 TO NPicked                 'check that EVERYONE and individuals aren't coincident
  318.          IF items$(picked(n)) = "EVERYONE" AND NPicked > 1 THEN
  319.          BEEP
  320.          LOCATE 20, 5: PRINT SPC(75);
  321.          LOCATE 20, 5: CALL MQPrint(" Do not select both individual users and the group EVERYONE! ", 4)
  322.          SLEEP 4
  323.          GOSUB ResetScreen
  324.          GOTO GetUserNames
  325.         END IF
  326.     NEXT n
  327. END IF
  328.  
  329. LOCATE 6, 18: CALL MQPrint(MidLine$, 8)                    ' draw message box/display message
  330. LOCATE 8, 18: CALL MQPrint(MidLine$, 8)
  331. LOCATE 6, 20: CALL MQPrint("Current message reads  :", 3)
  332. LOCATE 5, 18: CALL MQPrint(TopLine$, 8)
  333.  
  334. LOCATE 7, 18: CALL MQPrint(MidLine$, 8)
  335.  
  336. LOCATE 9, 18: CALL MQPrint(BottomLine$, 8)
  337. LOCATE 8, 20: CALL MQPrint(SendMessage$, 3)
  338. LOCATE 12, 20: CALL MQPrint("Sending message ...", 3)
  339. SLEEP 4
  340.  
  341. LOCATE 7, 2                               'Place window on line 7
  342. IF NPicked THEN
  343.     FOR n = 1 TO NPicked                 'send message to each user name picked
  344.     CLS
  345.     ShellLine$ = "SEND " + CHR$(34) + SendMessage$ + CHR$(34) + " " + Server$ + "/" + items$(picked(n))
  346.     SHELL ShellLine$
  347.     NEXT
  348. END IF
  349. SLEEP 5         'wait a few seconds to allow text from SEND command (error messages
  350. CLS             'and conformation of message sends) to display
  351.  
  352.  
  353. GetOut:
  354. CLS
  355. SYSTEM
  356.  
  357. '\*  subroutines \*
  358.  
  359. ExitNice:
  360. GOSUB ClearArea
  361.     
  362.     IF LEN(ErrorMsg$) = 0 THEN
  363.         LOCATE 14, 5: CALL MQPrint("Returning to system ...", 20)
  364.         CLOSE
  365.         SLEEP 2
  366.         GOTO GetOut
  367.     ELSE
  368.         LOCATE 12, 5: CALL MQPrint(ErrorMsg$, 4)
  369.         LOCATE 14, 5: CALL MQPrint("Returning to system ...", 20)
  370.         LOCATE 15, 5: CALL MQPrint("Hit any key to exit", 4)
  371.         WaitKey
  372.         CLOSE
  373.         GOTO GetOut
  374.     END IF
  375.  
  376. SetColor:
  377.     IF Peek1%(0, &H463) = &HB4 THEN      'mono monitor
  378.        FG = 0
  379.        BG = 7
  380.     ELSE                                 'color
  381.        FG = 7
  382.        BG = 1
  383.     END IF
  384.  
  385.     colr = OneColor%(FG, BG)             ' pack FG and BG into a single byte
  386.     TextColr = colr + 26                 ' color of text input bars
  387.     CLS
  388.     MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
  389. RETURN
  390.  
  391. ResetScreen:
  392.     CLS
  393.     MPaintBox 1, 1, 25, 80, Cnf.NonMen   ' initialize background color
  394.     LOCATE 2, 2: CALL MQPrint(" Novell SEND front end ", 3)
  395.     LOCATE 23, 5: CALL MQPrint(BottomMsg$, 3)   'function key menu
  396. RETURN
  397.  
  398. SelectScanCode:
  399.  
  400. SELECT CASE ScanCode
  401.  
  402.      CASE 59                ' F1  - help
  403.          GOSUB HelpMessage
  404.          GOSUB ResetScreen
  405.      CASE 61                ' F3  - calculator
  406.      Row = 4: Column = 55
  407.      SELECT CASE Monitor%            'see what type of monitor is present
  408.         CASE 3, 5, 7, 9, 10, 12      'CGA, EGA, VGA color
  409.            FG = 11
  410.            BG = 1
  411.         CASE ELSE                    'monochrome
  412.            FG = 15
  413.            BG = 0
  414.      END SELECT
  415.  
  416.      CALL NumOn              'turn on the NumLock key
  417.      CALL Calc(Row, Column, FG, BG)
  418.      CALL NumOff
  419.      CASE 63                ' F5  - calendar
  420.      SELECT CASE Monitor%            'see what type of monitor is present
  421.         CASE 3, 5, 7, 9, 10, 12      'CGA, EGA, VGA color
  422.            Colr1 = 1
  423.            Colr2 = 14
  424.         CASE ELSE                    'monochrome
  425.            Colr1 = 2
  426.            Colr2 = 15
  427.      END SELECT
  428. '         Colr1 = 2: Colr2 = 15   'b/w calendar colors (try 66 and 77 for CGA/EGA)
  429.      ULRow = 3: ULCol = 52   'upper left corner of calendar
  430.  
  431.      Month = VAL(LEFT$(DATE$, 2))    'take today's date from DOS
  432.      Year = VAL(RIGHT$(DATE$, 4))
  433.      Day = VAL(MID$(DATE$, 4, 2))
  434.  
  435.      Action = 1                      'display the calendar
  436.      CALL Calendar(Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
  437.      CALL WaitKey
  438.  
  439.      Action = 0                      'remove the calendar
  440.      CALL Calendar(Month, Day, Year, ULRow, ULCol, Colr1, Colr2, Action)
  441.      CASE 68                ' F10 - exit
  442.          GOTO ExitNice
  443.      CASE ELSE
  444.          GOSUB ResetScreen
  445.      END SELECT
  446.  
  447. RETURN
  448.  
  449. GetEnv:
  450.  
  451. GetEnvMsg1$ = "and bypass these informational messages."
  452.  
  453. '  Saber Menu environment strings used in this program
  454. '  S_SERVER=SERVERNAME      current server
  455. '  S_USER=SUPERVISOR        current user
  456. '  S_FILEDIR=F:\TRASH\      this is where temporary files will be written
  457. '                           F:\TRASH is a directory with all but parental
  458. '                           rights for the creation of transient files
  459.  
  460.     Server$ = ENVIRON$("S_SERVER")             ' Saber Menu's format
  461.     IF LEN(Server$) = 0 THEN
  462.         BEEP
  463.         GOSUB ClearArea
  464.         LOCATE 14, 5: CALL MQPrint("Cannot find S_SERVER environment string for default server", 3)
  465.         LOCATE 15, 5: CALL MQPrint("setting. If you wish, you can add one to your login script", 3)
  466.         LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
  467.         CALL GetQuery(Query$, ScanCode, XCode)
  468.         GOSUB SelectScanCode
  469.     END IF
  470.  
  471.     CurrentUser$ = ENVIRON$("S_USER")           ' Saber Menu's format
  472.     IF LEN(CurrentUser$) = 0 THEN
  473.         BEEP
  474.         GOSUB ClearArea
  475.         LOCATE 14, 5: CALL MQPrint("Cannot find S_USER environment string for current user", 3)
  476.         LOCATE 15, 5: CALL MQPrint("setting. If you wish, you can add one to your login script", 3)
  477.         LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
  478.         CALL GetQuery(Query$, ScanCode, XCode)
  479.         GOSUB SelectScanCode
  480.     END IF
  481.  
  482.     TempFilePath$ = ENVIRON$("S_FILEDIR")      ' Saber Menu's format
  483.     IF LEN(TempFilePath$) = 0 THEN
  484.         BEEP
  485.         GOSUB ClearArea
  486.         LOCATE 14, 5: CALL MQPrint("Cannot find S_FILEDIR environment string for temporary", 3)
  487.         LOCATE 15, 5: CALL MQPrint("file directory. If you wish, you can add one to your login script", 3)
  488.         LOCATE 16, 5: CALL MQPrint(GetEnvMsg1$, 3)
  489.         LOCATE 18, 5: CALL MQPrint("Will use the default directory, but you may have insufficient", 3)
  490.         LOCATE 19, 5: CALL MQPrint("rights to continue.", 3)
  491.         CALL GetQuery(Query$, ScanCode, XCode)
  492.         GOSUB SelectScanCode
  493.     END IF
  494.  
  495. RETURN
  496.  
  497. HelpMessage:
  498.     FOR x = 1 TO 14
  499.     READ L$
  500.     message$ = message$ + L$
  501.     NEXT x
  502.  
  503.     DATA "This program is a front end to the Novell Advanced Netware v2.15 SEND command. "
  504.     DATA "It expects Saber MENU v4.00+ compatable "
  505.     DATA "S_FILEDIR, S_SERVER, and S_USER environment variables to be "
  506.     DATA "available in the DOS environment, but may work without them (if the user has sufficient "
  507.     DATA "rights in the default directory). The 'default server' field is filled from "
  508.     DATA "S_SERVER, and temporary files are created in S_FILEDIR. You can edit, and have the "
  509.     DATA "opportunity to re-edit the server name. Once accepted, you are prompted to enter a "
  510.     DATA "message (which you can re-edit before sending). Finally, USERLIST is run "
  511.     DATA "to list the network users currently online, and allow you to send the message to whomever "
  512.     DATA "you select. The default group name EVERYONE is also included for global message "
  513.     DATA "broadcasts. This program has been tested on an EGA Packard Bell PB286 running DOS v3.30, "
  514.     DATA "SEND v1.11, and USERLIST v2.10. Legal text input box commands are {home}, {left}, {right}, {up}, {end}, "
  515.     DATA "{del}, {backspace}, {tab}, and {AltC} (which erases all text). "
  516.     DATA "As an added bonus, both a simple calculator and calendar are provided. "
  517.  
  518.     Wdth = 64               'a box 68 characters wide will be centered on screen
  519.     LOCATE 3                'the top of the box goes on line 3
  520.  
  521.     CALL MsgBox(message$, Wdth, Cnf)
  522.     CALL WaitKey            ' retrun after a key is pressed
  523.     CALL MsgBox("", 0, Cnf) 'reset msgbox
  524.     message$ = ""
  525.     RESTORE HelpMessage
  526. RETURN
  527.    
  528. ClearArea:
  529.     LOCATE 11, 1: PRINT SPC(80);    ' clear away any displayed text
  530.     LOCATE 12, 1: PRINT SPC(80);    ' to accentuate message
  531.     LOCATE 13, 1: PRINT SPC(80);
  532.     LOCATE 14, 1: PRINT SPC(80);
  533.     LOCATE 15, 1: PRINT SPC(80);
  534.     LOCATE 16, 1: PRINT SPC(80);
  535.     LOCATE 17, 1: PRINT SPC(80);
  536.     LOCATE 18, 1: PRINT SPC(80);
  537.     LOCATE 19, 1: PRINT SPC(80);
  538.     LOCATE 20, 1: PRINT SPC(80);
  539. RETURN
  540.  
  541.  
  542. DOShandler:
  543.     ' DOS error trapping
  544.     GOSUB ClearArea
  545.     SELECT CASE ERR
  546.         CASE 5
  547.         ErrorMsg$ = "Illegal function call"
  548.         GOTO ExitNice
  549.         CASE 6
  550.         ErrorMsg$ = "Overflow ... "
  551.         GOTO ExitNice
  552.         CASE 7
  553.         BEEP: BEEP
  554.         ErrorMsg$ = "Insufficient memory space"
  555.         GOTO ExitNice
  556.         CASE 9
  557.         BEEP: BEEP
  558.         ErrorMsg$ = "Subscript out of range"
  559.         GOTO ExitNice
  560.         CASE 11
  561.         BEEP: BEEP
  562.         ErrorMsg$ = "Division by zero"
  563.         GOTO ExitNice
  564.         CASE 13
  565.         BEEP
  566.         ErrorMsg$ = "Type mismatch"
  567.         GOTO ExitNice
  568.         CASE 14
  569.         BEEP
  570.         ErrorMsg$ = "Out of string space"
  571.         GOTO ExitNice
  572.         CASE 24
  573.         ErrorMsg$ = "DOS reports a device timeout."
  574.         GOTO ExitNice
  575.         CASE 25
  576.         BEEP
  577.         ErrorMsg$ = "DOS reports a device fault."
  578.         GOTO ExitNice
  579. '        CASE 27     'printer out of paper. Don't care in this applicaton
  580.         CASE 52
  581.         BEEP
  582.         ErrorMsg$ = "A 'bad file name or number' fault has occured"
  583.         GOTO ExitNice
  584.         CASE 53
  585.         ErrorMsg$ = "A 'file not found' fault has occured."
  586.         GOTO ExitNice
  587.         CASE 54
  588.         ErrorMsg$ = "A 'bad file mode' fault has occured."
  589.         GOTO ExitNice
  590.         CASE 55
  591.         ErrorMsg$ = "A 'file already open' error has occured."
  592.         GOTO ExitNice
  593.         CASE 56
  594.          ErrorMsg$ = "DOS error - FIELD statement active"
  595.     CASE 57
  596.          ErrorMsg$ = "DOS reports 'Device I/O error'"
  597.          GOTO ExitNice
  598.         CASE 58
  599.          ErrorMsg$ = "DOS reports 'file already exists'"
  600.          GOTO ExitNice
  601.         CASE 59
  602.          ErrorMsg$ = "DOS reports 'bad record length'"
  603.          GOTO ExitNice
  604.         CASE 61
  605.          BEEP: BEEP: BEEP
  606.          ErrorMsg$ = "DOS reports 'disk full' "
  607.          GOTO ExitNice
  608.         CASE 62
  609.          ErrorMsg$ = "DOS reports 'input past end of file'"
  610.          GOTO ExitNice
  611.         CASE 63
  612.          ErrorMsg$ = "DOS reports 'bad record number'"
  613.          GOTO ExitNice
  614.         CASE 64
  615.          ErrorMsg$ = "The 'bad file name' error has occured"
  616.          GOTO ExitNice
  617.         CASE 75 TO 76
  618.          ErrorMsg$ = "Bad path"
  619.          GOTO ExitNice
  620.     CASE ELSE
  621.          CLS
  622.          'GOSUB ClearArea
  623.          LOCATE 11, 5: CALL MQPrint("An untrapped error has occured. Please note the error", 4)
  624.          LOCATE 12, 5: CALL MQPrint("code, and report it to me. Hit any key to continue.", 4)
  625.          LOCATE 14, 5: CALL MQPrint("The error code is" + STR$(ERR), 4)
  626.          PRINT
  627.          CALL WaitKey
  628.     END SELECT
  629. GOTO ExitNice
  630.  
  631.  
  632. 'revision history
  633. '
  634. '08/08/90   Wrote initial version to fix problem with using SEND
  635. 'v1.00ß     from a batch file (i.e. - as with Saber Menu).
  636. '           Bare minimum .. could be improved w/o too much effort
  637. '
  638. '08/09/90   Added support for Saber Menu environment strings
  639. 'v1.10ß     Changed temporary file creation for unique filenames (to avoid
  640. '           problems when multiple users are sending messages simultaneously)
  641. '           Added group EVERYONE as 'built-in' global SEND recipient
  642. '
  643. '08/11/90   Added display of current time and date at message input screen
  644. 'v1.20ß     Added command line parameter handling (not tested)
  645. '           Added help and error message boxes    (not tested)
  646. '           Experimented with color combinations
  647. '
  648. '08/22/90   Truncated date display to hr:min format. Rework help screen.
  649. 'v1.30ß     Drop command line parameter options. Rework input routines.
  650. '           Comment source code. Tested on 3270 graphics adaptor. Added
  651. '           calculator and calendar. Final beta. Released into user community.
  652. '           Note : Made changes in QPRO TEXTIN.BAS module. Renamed TEXTIN2.BAS
  653.  
  654. REM $STATIC
  655. SUB GetQuery (Query$, ScanCode, XCode)
  656.     DO
  657.     Query$ = INKEY$
  658.     LOOP WHILE Query$ = ""
  659.     Query$ = UCASE$(Query$)
  660.  
  661.    IF LEN(Query$) > 1 THEN      ' scan code, not character
  662.       Query$ = RIGHT$(Query$, 1)
  663.       IF XCode > 58 THEN
  664.           ScanCode = VAL(LTRIM$(RTRIM$(STR$(XCode))))
  665.       ELSEIF ASC(Query$) > 58 THEN
  666.           ScanCode = ASC(LTRIM$(RTRIM$(Query$)))
  667.       END IF
  668.    ELSE
  669.       ScanCode = VAL(Query$)
  670.    END IF
  671.  
  672.    XCode = 0
  673. END SUB
  674.  
  675.